﻿Imports System.Runtime.InteropServices


Namespace elkmenu.Helper.Mathematics
  <ComDefaultInterface(GetType(IEvaluateExpression)), ClassInterface(ClassInterfaceType.None)> _
<ComSourceInterfaces(GetType(IEvaluateExpression))> _
  Public Class EvaluateExpression
    Implements IEvaluateExpression
    Private Shared Operators As New List(Of Char) From {"+"c, "-"c, "/"c, "*"c, "^"c}
    Private Shared reg As New System.Text.RegularExpressions.Regex(String.Format("{0}[0-9]+", System.Text.RegularExpressions.Regex.Escape("(-")))
    Private Shared lbr As New System.Text.RegularExpressions.Regex(String.Format("{0}[0-9]+", System.Text.RegularExpressions.Regex.Escape(")")))
    Private Shared rbr As New System.Text.RegularExpressions.Regex(String.Format("[0-9]+{0}", System.Text.RegularExpressions.Regex.Escape("(")))
    Private Shared IDList As New Stack(Of Int16)
    Private Const MaxID As Integer = 15000
    Private Shared Function GetID() As Int16
      If IDList.Count < 1 Then
        For i As Int16 = 0 To MaxID
          IDList.Push(i)
        Next
      End If
      Return IDList.Pop
    End Function
    Private _Ans As Double = 0
    Public ReadOnly Property Ans As Double Implements IEvaluateExpression.Ans
      Get
        Return _Ans
      End Get
    End Property
    Private Parameters As New Dictionary(Of String, Double)
    Private _UseFunctions As Boolean = False
    Private _UseParams As Boolean = True
    Private _UseConsts As Boolean = True
    Private _CorrectBrackets As Boolean = True
    Public Property UseFunctions As Boolean
      Get
        Return _UseFunctions
      End Get
      Set(value As Boolean)
        _UseFunctions = value
      End Set
    End Property
    Public Property UseParams As Boolean Implements IEvaluateExpression.UseParams
      Get
        Return _UseParams
      End Get
      Set(value As Boolean)
        _UseParams = value
      End Set
    End Property
    Public Property UseConsts As Boolean Implements IEvaluateExpression.UseConsts
      Get
        Return _UseConsts
      End Get
      Set(value As Boolean)
        _UseConsts = value
      End Set
    End Property
    Public Property CorrectBrackets As Boolean Implements IEvaluateExpression.CorrectBrackets
      Get
        Return _CorrectBrackets
      End Get
      Set(value As Boolean)
        _CorrectBrackets = value
      End Set
    End Property
    Private MatFunctions As New List(Of String)
    Public ReservedNames As New List(Of String)
    Private Consts As New Dictionary(Of String, Double) From {{"pi", Math.PI}}
    Public Function GetFunctionsMethodInfo() As List(Of System.Reflection.MethodInfo)
      Dim di As New List(Of System.Reflection.MethodInfo)
      di.AddRange(GetType(Math).GetMethods)
      Return di
    End Function
    Public Function getParams() As Dictionary(Of String, Double)
      Return Parameters
    End Function

    Public ReadOnly Property ParamCount As Integer Implements IEvaluateExpression.ParamCount
      Get
        Return Parameters.Count
      End Get
    End Property

    Private Functions As New Dictionary(Of String, Func(Of Double(), Double))
    Public Sub RegisterFunction(ByVal Name As String, ByVal [Function] As Func(Of Double(), Double))
      If Functions.ContainsKey(Name.ToLower) Then
        Functions(Name.ToLower) = [Function]
      Else
        Functions.Add(Name.ToLower, [Function])
      End If
    End Sub
    Public Sub UnRegisterFunction(ByVal Name As String)
      If Functions.ContainsKey(Name.ToLower) Then
        Functions.Remove(Name.ToLower)
      End If
    End Sub
    Private IllegalOperations As New List(Of String)
    Sub New()
      GetID()
      For Each s As Char In Operators
        If s <> "-"c Then
          For Each s2 As Char In Operators
            IllegalOperations.Add(s2 & s)
          Next
        End If
      Next
      For Each mi As Reflection.MethodInfo In GetType(Math).GetMethods
        MatFunctions.Add(mi.Name.ToLower)
      Next
      Evaluate("0+0-0*0/1+(-0)*(0-0+0*0/1)^1")
    End Sub
    Public Sub DelPar(ByVal name As String) Implements IEvaluateExpression.DelPar
      If Parameters.ContainsKey(name.ToLower) Then
        Parameters.Remove(name.ToLower)
      End If
    End Sub
    Public Sub SetPar(ByVal name As String, ByVal value As Double) Implements IEvaluateExpression.SetPar
      If MatFunctions.Contains(name.ToLower) OrElse ReservedNames.Contains(name.ToLower) Then
        Throw New Exception("Name kann nicht verwendet werden, da er für eine Funktion reserviert ist!")
      ElseIf Consts.ContainsKey(name.ToLower) Then
        Throw New Exception("Name kann nicht verwendet werden, da er für eine Konstante reserviert ist!")
      ElseIf name.ToLower = "ans" Then
        Throw New Exception("Name kann nicht verwendet werden, da er für das letzte Ergebnis reserviert ist!")
      ElseIf Double.TryParse(name, Nothing) Then
        Throw New Exception("Name kann nicht verwendet werden, da er nur aus Zahlen besteht!")
      Else
        If name.Length = 1 Then
          Dim c As Char = Char.Parse(name)
          If Operators.Contains(c) OrElse c = "="c Then
            Throw New Exception("Name kann nicht verwendet werden, da er ein Operator ist!")
          End If
        End If
        If Parameters.ContainsKey(name.ToLower) Then
          Parameters(name.ToLower) = value
        Else
          Parameters.Add(name.ToLower, value)
        End If
      End If
    End Sub
    Private numbers As New List(Of Stack(Of KeyValuePair(Of Int16, Double)))
    Private Minus As New List(Of Integer)
    Public Function Evaluate(ByVal S As String) As Double Implements IEvaluateExpression.Evaluate
      numbers.Clear()
      Minus.Clear()
      Dim foundIndex As New List(Of Integer)
      If String.IsNullOrEmpty(S.Trim) Then Return 0
      S = S.ToLower
      S = S.Replace(")(", ")*(")
      S = S.Replace(" ", "")
      If S.Contains("--") OrElse S.Contains("+-") OrElse S.Contains("*-") OrElse S.Contains("/-") Then
        Throw New Exception("Negative Zahlen müssen in Klammern eingeschlossen sein! z.B.: (-3)")
      End If
      For Each io As String In IllegalOperations
        If S.Contains(io) Then Throw New Exception("Zwei oder mehr aufeinanderfolgende Operatoren sind nicht erlaubt!")
      Next
      If _UseParams Then
        For Each kv As KeyValuePair(Of String, Double) In From x As KeyValuePair(Of String, Double) In Parameters Order By x.Key.Length Descending Select x
          S = S.Replace(kv.Key.ToLower, "(" & kv.Value.ToString & ")")
        Next
      End If
      If _UseConsts Then
        For Each kv As KeyValuePair(Of String, Double) In Consts
          S = S.Replace(kv.Key.ToLower, "(" & kv.Value.ToString & ")")
        Next
      End If
      If Ans < 0 Then
        S = S.Replace("ans", "(" & Ans.ToString & ")")
      Else
        S = S.Replace("ans", Ans.ToString)
      End If
      Dim brc As Integer = 0
      Dim brce As Integer = -1
      Dim brca As Integer = -1
      Dim first As Boolean = True
      Dim run As Boolean = False
      For Each m As System.Text.RegularExpressions.Match In reg.Matches(S)
        S = S.Replace(m.Value, "(" & m.Value.Replace("-", "0-") & ")")
      Next
      For Each m As System.Text.RegularExpressions.Match In lbr.Matches(S)
        S = S.Replace(m.Value, m.Value.Replace(")", ")*"))
      Next
      For Each m As System.Text.RegularExpressions.Match In rbr.Matches(S)
        S = S.Replace(m.Value, m.Value.Replace("(", "*("))
      Next
      Dim lb As Integer = -1
      Dim rb As Integer = -1
      Dim found As Boolean = True
      Do While found
        found = False
        For i As Integer = S.Length - 1 To 0 Step -1
          If S(i) = "^"c AndAlso Not foundIndex.Contains(i) Then
            For y As Integer = i - 1 To 0 Step -1
              If S(y) = "("c Then brc += 1
              If S(y) = ")"c Then brc -= 1
              If brc = 0 OrElse y = 0 Then
                lb = y
                Exit For
              End If
            Next
            For y As Integer = i + 1 To S.Length - 1
              If Not Char.IsDigit(S(y)) OrElse y = S.Length - 1 Then
                rb = y
                found = True
                Exit For
              End If
            Next
            If found Then
              foundIndex.Add(i + 1)
              Exit For
            End If
          End If
        Next
        If found Then
          If lb = 0 Then
            S = "(" & S
          Else
            S = S.Substring(0, lb) & "(" & S.Substring(lb)
          End If
          If rb = S.Length - 2 Then
            S = S & ")"
          Else
            S = S.Substring(0, rb + 1) & ")" & S.Substring(rb + 1)
          End If
        End If
      Loop
      If _CorrectBrackets Then
        Do Until run
          For i As Integer = 0 To S.Length - 1
            If S(i) = "("c Then brc += 1
            If S(i) = ")"c Then brc -= 1
          Next
          If brc < 0 Then
            For i As Integer = 1 To Math.Abs(brc)
              S = "(" & S
            Next
          ElseIf brc > 0 Then
            For i As Integer = 1 To Math.Abs(brc)
              S = S & ")"
            Next
          End If
          brc = 0
          For i As Integer = 0 To S.Length - 1
            If S(i) = "("c Then
              brc += 1
              If brca = -1 Then
                brca = i
              End If
            End If
            If S(i) = ")"c Then
              brc -= 1
              If brce = -1 AndAlso first Then
                first = False
                brce = i
              End If
            End If
          Next
          If brce = S.Length - 1 AndAlso brca = 0 Then
            S = S.Remove(brce, 1)
            S = S.Remove(brca, 1)
          Else
            run = True
          End If
        Loop
      End If
      If _UseFunctions Then
        Dim si As Integer = 0
        Dim fbrc As Integer = 0
        For Each sf As String In MatFunctions.Concat(Functions.Keys)
          found = True
          Do While found
            found = False
            If S.Contains(sf.ToLower) Then
              found = True
              si = S.IndexOf(sf.ToLower)
              Dim startingbracket As Boolean = False
              Dim endingbracket As Integer = -1
              For i As Integer = si To S.Length - 1
                If i > si + sf.Length - 1 Then
                  If i = si + sf.Length AndAlso S(i) = "("c Then startingbracket = True
                  If S(i) = "("c Then fbrc += 1
                  If S(i) = ")"c Then fbrc -= 1
                  If fbrc = 0 OrElse i = S.Length - 1 Then
                    endingbracket = i
                    Exit For
                  End If
                End If
              Next
              Dim tmps As String = S.Substring(si, (endingbracket - si) + 1)
              Dim args() As String = tmps.ToLower.Replace(sf.ToLower, "").Substring(1, tmps.Length - 2 - sf.Length).Split(":"c)
              Try
                If MatFunctions.Contains(sf.ToLower) Then
                  Dim argd(args.Count - 1) As Object
                  For y As Integer = 0 To argd.GetUpperBound(0)
                    argd(y) = Evaluate(args(y))
                  Next
                  S = S.Replace(tmps, GetType(Math).GetMethod(sf, Reflection.BindingFlags.Public Or Reflection.BindingFlags.IgnoreCase Or Reflection.BindingFlags.Static Or Reflection.BindingFlags.ExactBinding).Invoke(Nothing, argd).ToString)
                Else
                  Dim argd(args.Count - 1) As Double
                  For y As Integer = 0 To argd.GetUpperBound(0)
                    argd(y) = Evaluate(args(y))
                  Next
                  S = S.Replace(tmps, Functions(sf.ToLower)(argd).ToString)
                End If
              Catch ex As Exception
                Throw ex
              End Try
            End If
          Loop
        Next
      End If

      Dim OperatorList As New List(Of Char)

      numbers.Add(New Stack(Of KeyValuePair(Of Int16, Double)))

      Dim fun1 As Func(Of KeyValuePair(Of Int16, Double), Double) = Function(kv As KeyValuePair(Of Int16, Double)) As Double
                                                                      If Not Minus.Contains(kv.Key) Then Return kv.Value Else Return kv.Value * -1
                                                                    End Function
      Dim level As Integer = 0
      Dim currentoperator As Char = "+"c
      If S.Trim.StartsWith("-") Then
        currentoperator = "-"c
        S = S.Trim.Substring(1)
      End If
      Dim rem0 As New System.Predicate(Of Integer)(Function(g As Integer) As Boolean
                                                     If g = numbers(level).Peek.Key Then Return True Else Return False
                                                   End Function)
      Dim rem1 As New System.Predicate(Of Integer)(Function(g As Integer) As Boolean
                                                     If g = numbers(level - 1).Peek.Key Then Return True Else Return False
                                                   End Function)
      Dim value As Double
      Dim sVal As String = String.Empty
      Dim IsMinus As Boolean = False
      Dim lastpos As Integer = 0
      For i As Integer = 0 To S.Length - 1
        If i = 0 Then
          numbers(0).Push(NewValue(0))
        End If
        If S(i) = "(" Then
          level += 1
          OperatorList.Add(currentoperator)
          currentoperator = "+"c
          numbers.Add(New Stack(Of KeyValuePair(Of Int16, Double)))
          lastpos += 1
        ElseIf S(i) = ")" Then
          If lastpos = i Then
            lastpos += 1
          Else
            value = Double.Parse(Trim(S.Substring(lastpos, i - lastpos).Replace("(", "").Replace(")", "")))
            AddToStack(currentoperator, level, value, rem0)
          End If
          AddToStack(OperatorList(level - 1), level - 1, numbers(level).Sum(fun1), rem1)
          OperatorList.RemoveAt(OperatorList.Count - 1)
          numbers.RemoveAt(numbers.Count - 1)
          level -= 1
          lastpos = i + 1
        Else
          If Operators.Contains(S(i)) Then
            If lastpos = i Then
              lastpos += 1
            Else
              value = Double.Parse(Trim(S.Substring(lastpos, i - lastpos).Replace("(", "").Replace(")", "")))
              AddToStack(currentoperator, level, value, rem0)
            End If
            currentoperator = S(i)
            lastpos = i + 1
          End If
        End If
      Next
      If lastpos < S.Length Then
        value = Double.Parse(Trim(S.Substring(lastpos).Replace("(", "").Replace(")", "")))
        AddToStack(currentoperator, level, value, rem0)
      End If
      _Ans = numbers(level).Sum(fun1)
      Minus.Clear()
      Return _Ans
    End Function

    Private Sub AddToStack(ByVal [operator] As Char, ByVal level As Integer, ByVal value As Double, ByRef remx As System.Predicate(Of Integer))
      Dim isMinus As Boolean = False
      Select Case [operator]
        Case "+"c
          numbers(level).Push(NewValue(value))
        Case "-"c
          numbers(level).Push(NewValue(value))
          Minus.Add(numbers(level).Peek.Key)
        Case "*"c
          If Minus.Contains(numbers(level).Peek.Key) Then
            isMinus = True
            Minus.RemoveAll(remx)
          End If
          numbers(level).Push(NewValue(numbers(level).Pop.Value * value))
          If isMinus Then Minus.Add(numbers(level).Peek.Key)
          isMinus = False
        Case "/"c
          If Minus.Contains(numbers(level).Peek.Key) Then
            Minus.RemoveAll(remx)
            isMinus = True
          End If
          numbers(level).Push(NewValue(numbers(level).Pop.Value / value))
          If isMinus Then Minus.Add(numbers(level).Peek.Key)
          isMinus = False
        Case "^"c
          If Minus.Contains(numbers(level).Peek.Key) Then
            Minus.RemoveAll(remx)
            isMinus = True
          End If
          numbers(level).Push(NewValue(Math.Pow(numbers(level).Pop.Value, value)))
          If isMinus Then Minus.Add(numbers(level).Peek.Key)
          isMinus = False
      End Select
    End Sub


    Private Shared Function NewValue(ByVal d As Double) As KeyValuePair(Of Int16, Double)
      Return New KeyValuePair(Of Int16, Double)(GetID, d)
    End Function

    Public Function getParamName(index As Integer) As String Implements IEvaluateExpression.getParamName
      Return Parameters.ElementAt(index).Key
    End Function

    Public Function getParamValue(index As Integer) As Double Implements IEvaluateExpression.getParamValue
      Return Parameters.ElementAt(index).Value
    End Function

  End Class
End Namespace